home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / qbdoors.arc / DOORS.BAS next >
BASIC Source File  |  1987-11-23  |  3KB  |  66 lines
  1. 10 REM ***********************************
  2. 20 REM **     DOORS example program     **
  3. 30 REM **    written by Matt Malden     **    Also, down load Doors.bat
  4. 40 REM **          on 11/28/85          **        and Doors.doc
  5. 50 REM ** to demonstrate the use of the **
  6. 60 REM **     RBBS "Doors" feature      **
  7. 70 REM ** (RBBS (c) by Tom Mack, 1985)  **
  8. 80 REM ***********************************
  9. 100 ON ERROR GOTO 10000
  10. 510 REM Read in User's Name, Baud Rate, and other communication variables
  11. 520 OPEN "R",1,"b:MESSAGES":FIELD 1,128 AS R$
  12. 530 GET 1,2:BPS=VAL(MID$(R$,44,2)):PAR=VAL(MID$(R$,42,2))
  13. 540 RN$=LEFT$(R$,30):FOR I=LEN(RN$) TO 1 STEP -1
  14. 550 IF MID$(RN$,I,1)<>" " THEN 570
  15. 560 NEXT I
  16. 570 RN$=LEFT$(RN$,I):REM Rn$=Users name
  17. 580 IF PAR=-1 THEN P$="N,8,1,CS,DS,CD" ELSE P$="E,7,1,CS,DS,CD"
  18. 590 IF BPS=-3 THEN B$="1200," ELSE B$="300,":REM This line will have to be       modified for 2400 baud modems.
  19. 600 CLOSE #1
  20. 610 MCR=&H3FC:MSR=&H3FE:CR$=CHR$(13):LF$=CHR$(10)
  21. 620 OPEN "COM1:"+B$+P$ AS #3
  22. 630 KEY OFF:CLS
  23. 1000 REM Main Program
  24. 1010 LF=0:A$="Do you need line feeds?":GOSUB 4000
  25. 1020 IF LEFT$(B$,1)="Y" OR LEFT$(B$,1)="y" THEN LF=1
  26. 1030 RANDOMIZE TIMER
  27. 1040 NUMBER=INT(RND(1)*100)+1
  28. 1050 A$="":GOSUB 2010:A$="I have a number between 1 and 100.  Type <Q> at any time to quit.":GOSUB 2010
  29. 1060 TRY=1
  30. 1070 A$="Guess #"+STR$(TRY)+"?":GOSUB 4000
  31. 1080 IF LEFT$(B$,1)="Q" OR LEFT$(B$,1)="q" THEN 5010
  32. 1090 GUESS=VAL(B$):IF GUESS<1 OR GUESS>100 OR GUESS<>INT(GUESS) THEN A$="Invalid guess.":GOSUB 2000:GOTO 1070
  33. 1100 IF GUESS=NUMBER THEN A$="Yes, that's right!!!":GOSUB 2000:A$="Here we go again......":GOSUB 2010:GOTO 1040
  34. 1110 IF GUESS<NUMBER THEN A$="Too low.":GOSUB 2010:GOTO 1130
  35. 1120 A$="Too high.":GOSUB 2010
  36. 1130 TRY=TRY+1:GOTO 1070
  37. 2000 REM Print string with carriage return
  38. 2010 PRINT A$:PRINT #3,A$:IF LF=1 THEN PRINT #3,LF$
  39. 2020 RETURN
  40. 3000 REM Print string with carriage return suppressed
  41. 3010 PRINT A$;:PRINT #3,A$;:RETURN
  42. 4000 REM Input b$ string (a$ is printed as the question)
  43. 4010 B$="":GOSUB 3010
  44. 4020 WHILE EOF(3):Y$=INKEY$
  45. 4030 IF Y$<>"" THEN 4050 ELSE WEND:Y$="":GOSUB 4170
  46. 4040 Y$="":Y$=INPUT$(1,3):IF Y$=CHR$(127) THEN 4140
  47. 4050 IF Y$=CHR$(8) OR Y$=CHR$(7) OR Y$=CHR$(26) OR Y$=CHR$(27) THEN 4140
  48. 4060 IF Y$<" " AND Y$<>CR$ THEN 4020
  49. 4070 PRINT Y$;
  50. 4080 PRINT #3,Y$;
  51. 4090 IF Y$=CR$ THEN 4120
  52. 4100 IF LEN(B$)=>254 THEN A$="Input too long -- Try again":GOSUB 2010:GOTO 4010
  53. 4110 B$=B$+Y$:GOTO 4020
  54. 4120 IF LF=1 THEN PRINT #3,LF$
  55. 4130 RETURN
  56. 4140 IF LEN(B$)=0 THEN 4020
  57. 4150 B$=LEFT$(B$,LEN(B$)-1):PRINT CHR$(29);CHR$(32);CHR$(29);
  58. 4160 PRINT #3,CHR$(8);CHR$(32);CHR$(8);:GOTO 4020
  59. 4170 IF INP(MSR)<128 THEN 5020:REM User dropped carrier
  60. 4180 RETURN
  61. 5000 REM Return to DOS
  62. 5010 A$="Now returning to RBBS......":GOSUB 2000
  63. 5020 CLOSE 3:OUT MCR,INP(MCR)OR 1:SYSTEM
  64. 10000 IF ERR=57 AND ERL=4040 THEN 5020
  65. 10010 A$="Error #"+STR$(ERR)+" in line"+STR$(ERL)+".  Please tell SYSOP.":GOSUB 2000:GOTO 5010
  66.